home *** CD-ROM | disk | FTP | other *** search
/ MacWorld 1997 September / Macworld (1997-09).dmg / Shareware World / Utilities / Text Processing / Alpha / Tcl / Modes / cMode.tcl < prev    next >
Encoding:
Text File  |  1996-08-29  |  12.5 KB  |  452 lines  |  [TEXT/ALFA]
  1. # nowrap
  2.  
  3. if {$startingUp} {
  4.     addMode C dummyC { *.r } {cwarriorMenu thinkRefMenu}
  5.     addMode C++ dummyC++ {*.H *.c *.h *.cc *.cp *.cpp *.CPP *.C } { cwarriorMenu thinkRefMenu}
  6.     return
  7. }
  8.  
  9.  
  10. newModeVar C elecColon {1} 1
  11. newModeVar C elecRBrace {1} 1
  12. newModeVar C leftFillColumn {3} 0
  13. newModeVar C prefixString {//} 0 
  14. newModeVar C electricSemi {1} 1
  15. newModeVar C elecLBrace {1} 1
  16. newModeVar C elecElse {1} 1
  17. newModeVar C wordWrap {0} 1
  18. newModeVar C funcExpr {^[^ \t\(#\r/@].*\(.*\)$} 0
  19. newModeVar C parseExpr {\b([_:\w]+)\s*\(} 0
  20. newModeVar C wordBreak {[_\w]+} 0
  21. newModeVar C wordBreakPreface {[^_\w]} 0
  22. newModeVar C electricTab {1} 1
  23. newModeVar C autoMark    0    1
  24. newModeVar C stringColor    green    0
  25. newModeVar C commentColor    red    0
  26. newModeVar C funcColor        yellow    0
  27. newModeVar C keywordColor    blue    0
  28. newModeVar C CWCompSig    CWIE    0
  29. newModeVar C CWDbgSig    MWDB    0
  30. newModeVar C SymCompSig    KAHL    0
  31. newModeVar C SymDbgSig    {◊LSD}    0
  32.  
  33. set cCommentRegexp    {/\*(([^*]/)|[^*]|\r)*\*/}
  34. set cPreRegexp        {^\#[\t ]*[a-z]*}
  35. set    cKeyWords    {
  36.     void break register short enum extern int for if while struct static long continue
  37.     switch case char unsigned double float return else default goto do pascal Boolean
  38.     typedef volatile union auto sizeof size_t
  39. }
  40. if {[info exists Cwords]} {set cKeyWords [concat $cKeyWords $Cwords]}
  41. regModeKeywords -e {//} -b {/*} {*/} -c $CmodeVars(commentColor) -f $CmodeVars(funcColor) -k $CmodeVars(keywordColor) -s $CmodeVars(stringColor) -m {#} C $cKeyWords
  42.  
  43. #================================================================================
  44.  
  45. newModeVar C++ elecColon {1} 1
  46. newModeVar C++ elecRBrace {1} 1
  47. newModeVar C++ leftFillColumn {3} 0
  48. newModeVar C++ prefixString {//} 0
  49. newModeVar C++ electricSemi {1} 1
  50. newModeVar C++ wordBreak {[\w_]+} 0
  51. newModeVar C++ wordBreakPreface {[^_\w]} 0
  52. newModeVar C++ elecLBrace {1} 1
  53. newModeVar C++ elecElse {1} 1
  54. newModeVar C++ wordWrap {0} 1
  55. newModeVar C++ funcExpr {^[^ \t\(#\r/@].*\(.*\)$} 0
  56. newModeVar C++ parseExpr {\b([_:\w]+)\s*\(} 0
  57. newModeVar C++ electricTab {1} 1
  58. newModeVar C++ autoMark        0    1
  59. newModeVar C++ stringColor    green    0
  60. newModeVar C++ commentColor    red        0
  61. newModeVar C++ keywordColor    blue    0
  62. newModeVar C++ funcColor    yellow    0
  63. newModeVar C++ CWCompSig    CWIE    0
  64. newModeVar C++ CWDbgSig        MWDB    0
  65. newModeVar C++ SymCompSig    KAHL    0
  66. newModeVar C++ SymDbgSig    {◊LSD}    0
  67.  
  68.  
  69. set {c++KeyWords} {
  70.     new delete class friend protected private public template 
  71.     try catch throw operator const mutable virtual asm inline this
  72.     and and_eq bitand bitor compl not or or_eq xor xor_eq not_eq
  73.     wchar_t bool true false
  74.     static_cast dynamic_cast reinterpret_cast typeid
  75.     using namespace inherited
  76. }
  77. if {[info exists {C++words}]} {
  78.     set {c++KeyWords} [concat ${c++KeyWords} ${C++words} $cKeyWords]
  79. } else {
  80.     set {c++KeyWords} [concat ${c++KeyWords} $cKeyWords]
  81. }
  82.  
  83. regModeKeywords -e {//} -b {/*} {*/} -c [set C++modeVars(commentColor)] -f [set C++modeVars(funcColor)] -k [set C++modeVars(keywordColor)] -s [set C++modeVars(stringColor)] -m {#} {C++} ${c++KeyWords}
  84. unset cKeyWords
  85. unset {c++KeyWords}
  86.  
  87. #=============================================================================
  88. # "Electric" C functions.
  89. #=============================================================================
  90.  
  91. # returns the indent string of the line named by 'pos'
  92. proc indentString pos {
  93.     set start [lineStart $pos]
  94.     set end [nextLineStart $pos]
  95.     set text [getText $start $end]
  96.     for {set i 0} {1} {incr i} {
  97.         set c [string index $text $i]
  98.         if {($c != "\ ") && ($c != "\t")} then {
  99.             return [string range $text 0 [expr $i-1]]
  100.         }
  101.     }
  102.     return
  103. }
  104.  
  105.  
  106. # Brace on new line, same indentation. Insert on another new line, indented in.
  107. # First, see if we are on new line.
  108.  
  109. #    if {($i == $pos) || ([lookAt $pos] == " ")} {
  110. bind '\{' <s> electricLeft C
  111. bind '\{' <s> electricLeft C++
  112.  
  113.  
  114. # Brace on new line, immediate carriage return
  115.  
  116. bind '\}' <s> electricRight C
  117. bind '\}' <s> electricRight C++
  118.  
  119.  
  120. # Brace on new line, immediate carriage return. We don't do our electric stuff
  121. # if we are in the middle of a for statement.
  122. bind '\;' electricSemi C
  123. bind '\;' electricSemi C++
  124.  
  125.  
  126. proc ordSemi {} {
  127.     insertText {;}
  128. }
  129.  
  130. bind '\;' <z> ordSemi
  131.  
  132.  
  133. proc cppCR {} {
  134.     if {[lookAt [expr [getPos] - 1]] == ":"} {
  135.         if { [lookAt [getPos]] == "\r" } {
  136.             indentLine
  137.             endOfLine
  138.             carriageReturn
  139.         } else {
  140.             set pos [getPos]
  141.             endOfLine
  142.             set t [getText $pos [getPos]]
  143.             replaceText $pos [getPos] ""
  144.             indentLine
  145.             endOfLine
  146.             carriageReturn
  147.             insertText $t
  148.         }
  149.         indentLine
  150.     } else {
  151.         carriageReturn
  152.         indentLine
  153.     }
  154.     
  155. }
  156.  
  157. bind '\r'     cppCR C
  158. bind '\r'     cppCR C++
  159.         
  160. #================================================================================
  161.  
  162. # proc CMarkFile {} {
  163. #     global CmodeVars
  164. #     set pos 0
  165. #     while {![catch {search -s -f 1 -r 1 -m 0 -i 0 $CmodeVars(funcExpr) $pos} res]} {
  166. #         set start [lindex $res 0]
  167. #         set end [expr [lindex $res 1] + 1]
  168. #         set text [getText $start $end]
  169. #         if {[regexp {([a-zA-Z0-9:_]+)[ \t]*\(} $text dummy word]} {
  170. #             set tmp [expr $start + [string first $word $text]]
  171. #             set inds($word) "$tmp [expr $tmp + [string length $word]]"
  172. #         }
  173. #         set pos $end
  174. #     }
  175. #     if {[info exists inds]} {
  176. #         foreach f [lsort -ignore [array names inds]] {
  177. #             set res $inds($f)
  178. #             setNamedMark $f [lineStart [lindex $res 0]] [lindex $res 0] [lindex $res 1]
  179. #         }
  180. #     }
  181. # }
  182. # 
  183. #     
  184. # #The previous version would not find things like     void    *ThisFunc( xxx ) due to the asterisk
  185. # #I also truncated the pattern.  The rest is not necessary and intrusive as far as I can tell   
  186. # proc C++MarkFile {} {
  187. #     set pos 0
  188. #     while {![catch {search -s -f 1 -r 1 -m 0 -i 0 {^([^ \t\(#\r/@].*[ \t]+)?\*?([A-Za-z0-9:~_]+)[ \t\r]*\(} $pos} res]} {
  189. #         set start [lindex $res 0]
  190. #         set end [expr [lindex $res 1] + 1]
  191. #         set thistext [getText $start $end]
  192. #         #regexp doesn't like carriage returns
  193. #         regsub -all "\r" $thistext " " thistext
  194. #         #regexp doesn't like tabs either
  195. #         regsub -all "\t" $thistext " " thistext
  196. #         #if the open paren was the last character on the line the selected text included the last carriage return as well
  197. #         #trim this off now that it is changed into a space
  198. #         set thistext [string trimright $thistext]
  199. #         if {[regexp {([a-zA-Z0-9:~_]+)[ \t]*\(} $thistext dummy word]} {
  200. #             set inds($word) [lineStart [expr $start - 1]]
  201. #         }
  202. #         set pos $end
  203. #     }
  204. #     if {[info exists inds]} {
  205. #         foreach f [lsort -ignore [array names inds]] {
  206. #             set next [nextLineStart $inds($f)]
  207. #             setNamedMark $f $inds($f) $next $next
  208. #         }
  209. #     }
  210. # }
  211.  
  212.  
  213. proc CMarkFile {} {
  214.     global CmodeVars
  215.     set pos 0
  216.  
  217.     while {![catch {search -s -f 1 -r 1 -m 0 -i 0 $CmodeVars(funcExpr) $pos} res]} {
  218.         set start [lindex $res 0]
  219.         set end [expr [lindex $res 1] + 1]
  220.         set text [getText $start $end]
  221.         if {[regexp {([a-zA-Z0-9:_]+)[ \t]*\(} $text dummy word]} {
  222.             set tmp [expr $start + [string first $word $text]]
  223.             set inds($word) "$tmp [expr $tmp + [string length $word]]"
  224.         }
  225.         set pos $end
  226.     }
  227.  
  228.     ## 
  229.      # Also    mark any class or struct definitions
  230.      ##
  231.     
  232.     set markExpr {^(class|struct) \w+[ \t]*(:|\{)}
  233.     while {![catch {search -s -f 1 -r 1 -m 0 -i 0 "$markExpr" $pos} res]} {
  234.         set start [lindex $res 0]
  235.         set end [expr [lindex $res 1] -1]
  236.         set text [string trimright [getText $start $end] ]
  237.         set inds($text) "$start [expr $start + [string length $text]]"
  238.         set pos $end
  239.     }
  240.     if {[info exists inds]} {
  241.         foreach f [lsort -ignore [array names inds]] {
  242.             set res $inds($f)
  243.             setNamedMark $f [lineStart [lindex $res 0]] [lindex $res 0] [lindex $res 1]
  244.         }
  245.     }
  246. }
  247.  
  248. ## 
  249.  # -------------------------------------------------------------------------
  250.  #     
  251.  # "C++MarkFile" --
  252.  #    
  253.  #    Improved version which handles templates, operators    etc.
  254.  #    Makes use of the new mark menu in Alpha    6.2b7 which    can    handle
  255.  #    more weird characters.
  256.  #           
  257.  # -------------------------------------------------------------------------
  258.  ##
  259. proc C++MarkFile {} {
  260.     set pos 0
  261.     set markExpr {^([^ \t\(#\r/@].*[ \t]+)?\*?([A-Za-z0-9<>~_]+::[- <>A-Za-z0-9~_+=\|\*/]+|[A-Za-z0-9~_]+)[ \t\r]*\(}
  262.     while {![catch {search -s -f 1 -r 1 -m 0 -i 0 "$markExpr" $pos} res]} {
  263.         set start [lindex $res 0]
  264.         set end [expr [lindex $res 1] + 1]
  265.         set thistext [getText $start $end]
  266.         #regexp doesn't like carriage returns
  267.         regsub -all "\r" $thistext " " thistext
  268.         #regexp doesn't like tabs either
  269.         regsub -all "\t" $thistext " " thistext
  270.         #if the open paren was the last character on the line the selected text 
  271.         #included the last carriage return as well
  272.         #trim this off now that it is changed into a space
  273.         set thistext [string trimright $thistext]
  274.         if {[regexp {([A-Za-z0-9<>~_]+::[- <>A-Za-z0-9~_+=\|\*/]+|[A-Za-z0-9~_]+)[ \t]*\(} $thistext dummy word]} {
  275.             if { [string first "::" $word] != -1 } {
  276.                 regsub {(<\w+>)?::} $word " " it
  277.                 set l [lindex $it 0]
  278.                 if { $l == [lindex $it 1] } {
  279.                     set word "Construct '$l'"
  280.                 } elseif { "~$l" == [lindex $it 1] } {
  281.                     set word "Destruct '$l'"
  282.                 }
  283.             }
  284.             set inds($word) [lineStart [expr $start - 1]]
  285.         }
  286.         set pos $end
  287.     }
  288.     if {[info exists inds]} {
  289.         foreach f [lsort -ignore [array names inds]] {
  290.             set next [nextLineStart $inds($f)]
  291.             if {[string length $f] > 35} { 
  292.                 setNamedMark "[string range $f 0 31]..." "$inds($f)" $next $next
  293.             } else {
  294.                 setNamedMark $f "$inds($f)" $next $next
  295.             }
  296.         }
  297.     }
  298. }
  299.  
  300. proc setC++Mode {} {
  301.     changeMode "C++"
  302. }
  303.  
  304.  
  305.  
  306. proc dummyC {} {}
  307. proc dummyC++ {} {}
  308.  
  309.  
  310. #===============================================================================
  311.  
  312. proc CDblClick {from to} {
  313.     global tagFile
  314.     
  315.     if {[regexp {#include.*("|<)(.*)("|>)} [getText [lineStart [getPos]] [nextLineStart [getPos]]] d1 d1 inc]} {
  316.         return [cIncludeFile $inc]
  317.     }
  318.  
  319.     select $from $to
  320.     set text [getSelect]
  321.     
  322.     set lines [grep "^$text'" $tagFile]
  323.     if {[regexp {'(.*)'(.*[^\t])(\t)+∞} $lines dummy one two]} {
  324.         if {[string match "*$one*" [winNames -f]]} {
  325.             bringToFront $one
  326.         } else {
  327.             edit $one
  328.         }
  329.         set inds [search -f 1 -r 0 "$two" 0]
  330.         display [lindex $inds 0]
  331.         eval select $inds
  332.     } else {
  333.         launchForeAppl DanR
  334.         AEBuild {'DanR'} DanR {REF } "----" "“$text”"
  335.     }
  336. }
  337.  
  338. proc C++DblClick {from to shift option control} {
  339.     CDblClick $from $to
  340. }
  341.  
  342.  
  343. #===============================================================================
  344. proc cIncludeProc {menu item} {
  345.     switch $item {
  346.         open    {
  347.             set text [getText [lineStart [getPos]] [nextLineStart [getPos]]]
  348.             if {[regexp {["<]([^">]*)[">]} $text dummy fname]} {
  349.                 cIncludeFile $fname
  350.             }
  351.         }
  352.         addFolder { lappend cIncludePath [string trimright [get_directory] ":"]
  353.             rebuildHeaderMenu
  354.         }
  355.         removeFolder {
  356.             set item [listpick -p "Remove which folder?" [lsort $cIncludePath]]
  357.             set res [lsearch $cIncludePath $item]
  358.             set cIncludePath [lreplace $cIncludePath $res $res]
  359.             rebuildHeaderMenu
  360.         }
  361.     }
  362. }
  363.  
  364.  
  365. proc rebuildHeaderMenu {} {
  366.     global cIncludePath
  367.     
  368.     eval menu -n headers -p cIncludeProc $cIncludePath
  369. }
  370.  
  371.  
  372. proc cIncludeFile {fname} {
  373.     global cIncludePath
  374.     if {[file exists "[file dir [car [winNames -f]]]:$fname"]} {
  375.         edit "[file dir [car [winNames -f]]]:$fname"
  376.         return
  377.     }
  378.     
  379.     foreach path $cIncludePath {
  380.         if {[file exists "$path:$fname"]} {
  381.             edit "$path:$fname"
  382.             return
  383.         }
  384.     }
  385.     if {[askyesno "'$fname' can not be found, do you wish to add an include path?"]} {
  386.         lappend cIncludePath [string trimright [get_directory] ":"]
  387.         cIncludeFile $fname
  388.     }
  389. }
  390.  
  391.  
  392. proc getIncludeFiles {} {
  393.     global cIncludePath modeMenus mode
  394.  
  395.     if {[string match "*thinkMenu*" $modeMenus($mode)]} {return [thinkGetIncludeFiles]}
  396.  
  397.     set cid [scancontext create]
  398.     set lines {}
  399.     scanmatch $cid {#.*include.*(<|")(.*)(>|")}  {lappend lines $matchInfo(submatch1)}
  400.     set fid [open [car [winNames -f]] "r"]
  401.     scanfile $cid $fid
  402.     close $fid
  403.     scancontext delete $cid
  404.     return [lsort -ignore $lines]
  405. }
  406.  
  407.  
  408. proc editIncludeFile {fname} {
  409.     global modeMenus mode
  410.  
  411.     if {[string match "*thinkMenu*" $modeMenus($mode)]} {return [thinkEditIncludeFile $fname]}
  412.  
  413.     cIncludeFile $fname
  414. }
  415.  
  416.  
  417. #===============================================================================
  418. proc parseFuncsC {} {
  419.     global mode sortFuncsMenu
  420.     global funcExpr parseExpr
  421.     
  422.     set pos 0
  423.     if $sortFuncsMenu {
  424.         while {[set res [search -s -f 1 -r 1 -i 0 -n $funcExpr $pos]] != ""} {
  425.             if {[regexp $parseExpr [getText [car $res] [cadr $res]] dummy word]} {
  426.                 lappend m [list $word [car $res]]
  427.             }
  428.             set pos [cadr $res]
  429.         }
  430.         regsub -all "\[\{\}\]" [lsort -ignore $m] "" m
  431.     } else {
  432.         while {[set res [search -s -f 1 -r 1 -i 0 -n $funcExpr $pos]] != ""} {
  433.             if {[regexp $parseExpr [getText [car $res] [cadr $res]] dummy word]} {
  434.                 lappend m $word [car $res]
  435.             }
  436.             set pos [cadr $res]
  437.         }
  438.     }
  439.     
  440.     set files ""
  441.     foreach f [getIncludeFiles] {
  442.         lappend files $f -1
  443.     }
  444.     return [concat $files [list "(-" 0] $m]
  445. }
  446.  
  447. proc parseFuncsC++ {} {
  448.     return [parseFuncsC]
  449. }
  450.  
  451. #===============================================================================
  452.